TallerdeMuestreo:

Caso:“DesastresNaturales”:

En la base de datos relacionada, se encuentra el “Registro de Eventos Naturales o Antrópicos no Intencionales”ocurridos durante el año 2019, que fueron reportados a la UNGRD (Unidad Nacional para la Gestión del Riesgo de Desastres) con su respectiva afectación y atención prestada a cada uno. https://www.datos.gov.co/Ambiente-y-Desarrollo-Sostenible/Emergencias-UNGRD-2019/4fd8-ptcr (BaseExcelDepurada)

Actividad:

Asumiendo que esta base de datos es el marco de muestreo de su investigación, y teniendo en cuenta que el atributo más importante para su investigación son los EVENTOS, y en especial el evento, el evento INCENDIO DE COBERTURA VEGETAL, bajo un nivel de confianza del 93%, y asumiendo un error de muestreo en las estimaciones no superior a 3%; proporcione un tamaño mínimo de muestra (bajo un muestreo aleatorio simple), para realizar las estimaciones que se indican a continuación, semilla (3564). (Peso 30%)

Desarrollo:

Se estima el tamaño de la muestra usando la fórmuala definida por la máxima varibilidad de los parametros p y q ( se asumen p=q=0.5). Como resultado se obtiene una muestra de tamaño n= 757 observaciones . Y se define un nuevo dataframe nombrado: muestra_inc , q contiene las observaciones de la muestra solicitada, adicionalmente fue necesario en el proceso de limpieza se quitaros 2 registros , un dato que corresponde a Perú y un registro vacio.

N = nrow(Incendios) ## N corresponde a la población total del estudio que son el total de registros


z = qnorm(0.035, mean= 0, sd = 1, lower.tail = TRUE)# Se defini el valor Z a un nivel de significancia α=0,07

 
d = 0.03 # Corresponde al error del 3% asumido por el investigador

n = z*z*0.5*0.5/(d*d+(z*z*0.5*0.5)/N) # Tamaño de la muestra


n = ceiling(n)


set.seed(3564)
muestra_inc <- Incendios [ sample (N, size = n ),]
#Se genera un nuevo dataframe con las observaciones de la muestra

A través de la muestra seleccionada, proporcione las siguientes estimaciones con su margen de error (Var, EE, CV, IC): Estimación del total de personas fallecidas y promedio de personas heridas, en los casos de EVENTOS: INCENDIOS DE COBERTURA VEGETAL ( Peso 30%)

MediaH=mean(muestra_inc$HERIDOS)

MediaF=mean(muestra_inc$FALLECIDOS)

#Estimaciones
VarH=var(muestra_inc$HERIDOS)

VarEstim=(1-n/N)*VarH/n

EE=sqrt(VarEstim)

CV=(EE/MediaH)*100

valort=qt(c(0.025),df=(757-1),lower.tail = FALSE)# Valor t a un nivel de significancia de 0.025, que equivale a un nivel de confianza del 95%.

Lsup=MediaH+(valort*EE) # Cálculo del límite superior de intervalo de confianza
Linf=MediaH-(valort*EE) # Cálculo del límite inferior de intervalo de confianza


resumenMediaH1 <- data.frame(n ,MediaH,VarEstim,EE,Linf,Lsup,CV)

Con un nivel de confianza del 95% el promedio de los heridos de la población va a ser de 0.39, tal como se observa en el siguiente resumen:

resumenMediaH1

##     n    MediaH    VarEstim        EE      Linf      Lsup       CV
## 1 757 0.3949802 0.004380507 0.0661854 0.2650512 0.5249092 16.75664

Estimación del total de los fallecidos se calcula de la siguiente forma:

EstimTot=N*MediaF
EstimTot

## [1] 574.148

##

VarF=var(muestra_inc$FALLECIDOS)

VarEstimF=(1-757/4435)*VarF/757

EEf=sqrt(VarEstimF)

CVf=(EEf/MediaF)*100

VarEstimTOT=(N^2)*VarEstimF

EETot=sqrt(VarEstimTOT)


valortF=qt(c(0.025),df=(757-1),lower.tail = FALSE)# Valor t a un nivel de significancia de 0.025, que equivale a un nivel de confianza del 95%.

LsupTotF=EstimTot+(valortF*EETot) # Cálculo del límite superior de intervalo de confianza
LinfTotF=EstimTot-(valortF*EETot) # Cálculo del límite inferior de intervalo de confianza

CVTot=(EETot/EstimTot)*100


resumenTotF <- data.frame(n ,EstimTot,VarEstimTOT,EETot,LinfTotF,LsupTotF,CVTot)
resumenTotF

##     n EstimTot VarEstimTOT    EETot LinfTotF LsupTotF    CVTot
## 1 757  574.148     33271.7 182.4053 216.0668 932.2291 31.76974

Con un nivel de confianza del 95% el total de fallecidos es 574.148 tal como se observa en el siguiente resumen junto con los demás estadísticos solicitados:

resumenTotF

##     n EstimTot VarEstimTOT    EETot LinfTotF LsupTotF    CVTot
## 1 757  574.148     33271.7 182.4053 216.0668 932.2291 31.76974

Tome la estimación del promedio de personas heridas (calculado anteriormente), desagréguelo por departamentos, y haga una representación cartográfica (Exclusivamente con la metodología – Código R usado en la clase anterior) de su estimación promedio. (Peso 30%)

## Cartografía


sp_df <- readOGR(dsn = "MGN2021_DPTO_POLITICO", layer = "MGN_DPTO_POLITICO")

## Warning in OGRSpatialRef(dsn, layer, morphFromESRI = morphFromESRI, dumpSRS =
## dumpSRS, : Discarded datum Marco_Geocentrico_Nacional_de_Referencia in Proj4
## definition: +proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs

## OGR data source with driver: ESRI Shapefile 
## Source: "C:\Users\alexg\Documents\GitHub\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO", layer: "MGN_DPTO_POLITICO"
## with 33 features
## It has 9 fields

#head(sp_df)
#fix(sp_df)
#as.data.frame(sp_df)

DPTO_SH="MGN2021_DPTO_POLITICO/MGN_DPTO_POLITICO.shp"

DPTO_SH2 <- st_read(DPTO_SH)

## Reading layer `MGN_DPTO_POLITICO' from data source 
##   `C:\Users\alexg\Documents\GitHub\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO\MGN_DPTO_POLITICO.shp' 
##   using driver `ESRI Shapefile'
## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS:  MAGNA-SIRGAS

HeridosDepto <- muestra_inc %>%
group_by(DEPARTAMENTO) %>%
  summarise(promedioH = mean(HERIDOS),COD_DANE)

## `summarise()` has grouped output by 'DEPARTAMENTO'. You can override using the
## `.groups` argument.

HeridosDepto$promedioH<-round(HeridosDepto$promedioH,2)


# Para visualizar la base resumida
ResumenH=as.data.frame(HeridosDepto)

#ResumenH



Etiquetas=unite(ResumenH, Etiqueta,c(1,2), sep = ": ", remove = TRUE)
Etiquetas=Etiquetas[,1]
#Etiquetas



Resumen3=cbind(ResumenH, Etiquetas )
#Resumen3


DPTO_SH2

## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS:  MAGNA-SIRGAS
## First 10 features:
##    DPTO_CCDGO   DPTO_CNMBR DPTO_ANO_C                         DPTO_ACT_A
## 1          05    ANTIOQUIA       1886      Constitucion Politica de 1886
## 2          08    ATLÁNTICO       1910                     Ley 21 de 1910
## 3          11 BOGOTÁ, D.C.       1538      Constitucion Politica de 1886
## 4          13      BOLÍVAR       1886      Constitucion Politica de 1886
## 5          15       BOYACÁ       1886      Constitucion Politica de 1886
## 6          17       CALDAS       1905                11 de Abril de 1905
## 7          18      CAQUETÁ       1981 Ley 78 del 29 de Diciembre de 1981
## 8          19        CAUCA       1857                15 de junio de 1857
## 9          20        CESAR       1967        Ley 25  21 de junio de 1967
## 10         23      CÓRDOBA       1951  Ley 9 del 18 de Diciembre de 1951
##    DPTO_NAREA DPTO_CSMBL DPTO_VGNC Shape_Leng Shape_Area
## 1   62808.630          3      2021  21.492374  5.1352363
## 2    3314.447          3      2021   2.573162  0.2738225
## 3    1622.853          3      2021   3.765324  0.1322079
## 4   26719.968          3      2021  16.233072  2.1956393
## 5   23138.048          3      2021  15.906491  1.8883908
## 6    7425.246          3      2021   6.663759  0.6054998
## 7   92831.284          3      2021  21.218741  7.5402411
## 8   31242.803          3      2021  13.955090  2.5344101
## 9   22565.307          3      2021  12.578459  1.8582044
## 10  25086.221          3      2021   9.725656  2.0575064
##                          geometry
## 1  MULTIPOLYGON (((-76.41355 8...
## 2  MULTIPOLYGON (((-74.84946 1...
## 3  MULTIPOLYGON (((-74.07059 4...
## 4  MULTIPOLYGON (((-76.17318 9...
## 5  MULTIPOLYGON (((-72.17368 7...
## 6  MULTIPOLYGON (((-74.67154 5...
## 7  MULTIPOLYGON (((-74.79916 2...
## 8  MULTIPOLYGON (((-76.45922 3...
## 9  MULTIPOLYGON (((-73.45335 1...
## 10 MULTIPOLYGON (((-75.88119 9...

DPTO_JOIN <- geo_join(DPTO_SH2, Resumen3,"DPTO_CCDGO", "COD_DANE")

## Warning: We recommend using the dplyr::*_join() family of functions instead.

## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

#DPTO_JOIN = as.data.frame(DPTO_JOIN)
#DPTO_JOIN


pal <- colorNumeric( palette = "RdYlBu", domain=DPTO_JOIN$promedioH)  #palette = "YlGnBu"   "RdBu"  "RdYlBu"  "Spectral"  "Paired"  "PuRd"  "RdYlGn"


popup_sb <- paste0("Promedio de Heridos: ", as.character(DPTO_JOIN$promedioH))


leaflet(sp_df) %>%
  addProviderTiles("CartoDB.Positron") %>%
  #setView(-98.483330, 38.712046, zoom = 4) %>% 
  addPolygons(data = DPTO_JOIN , 
              fillColor = ~pal(DPTO_JOIN$promedioH),
              opacity = 1,
              color = "black",
              dashArray = "3",fillOpacity = 0.9,
              highlight = highlightOptions(
                weight = 1,
                color = "#666",
                dashArray = "",
                fillOpacity = 1,
                bringToFront = TRUE),
              label = DPTO_JOIN$Etiquetas,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto"))%>%
  addLegend(pal = pal, values =DPTO_JOIN$promedioH, opacity = 0.7, title = NULL,
            position = "bottomright")

## Warning: sf layer has inconsistent datum (+proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs).
## Need '+proj=longlat +datum=WGS84'

Taller_MAS

Sergio Castañeda, Guillermo Castillo, Alexander Guecha